Aminet 28/Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso/Aminet/util/rexx/cliped111.lha/cliped/cliped.rexx

OS/2 REXX Batch file | 1998-09-08 | 12.8 KB | 453 lines

/*
** $VER: cliped.rexx 1.11 (30.8.98) Rolf Rotvel
**
** Uses rexxreqtools.library
*/

call addlib('rexxreqtools.library', 0, -30, 0)
call addlib('rexxsupport.library', 0, -30, 0)

rxlv.width = 300
rxlv.height = 200

nl = '0a'x
cr = '0d'x
sep = '¤'

defgads = '_Ok|_Cancel'
title = 'ClipEd 'word(sourceline(2), 4)

call rxlv_init()
call get_clips()

do forever
     num = rxlv_main(title'  ['numclips']  <HELP> for keys.', 'dDeEqQrRnNuU')
     upkey = upper(rxlv.key)
     select
         when (upkey = 'D' | upkey = 'DEL') & num > 0 then call delete_clip(num)
         when (upkey = 'Q' | upkey = 'ESC') then exit
         when upkey = 'E' & num > 0 then call edit_clip(num)
         when upkey = 'N' then call create_clip()
         when upkey = 'R' then call rename_clip(num)
         when upkey = 'U' then call get_clips()
         otherwise do       /* 'RET' */
             if num > 0 then call view_clip(num)
         end
     end
end


GET_CLIPS:
clipnames = show('c',, sep)

if clipnames ~= '' then do
    c = 1
    len = 0
    do forever
        parse var clipnames clip.name.c (sep) clipnames

        if clip.name.c = '' then leave  /* No more clips */

        clip.value.c = checklf(getclip(clip.name.c))    /* Check clips for lf/cr */

        len = max(len, length(clip.name.c))
        c = c + 1
    end
    numclips = c - 1

    do f = 1 to numclips
        viewline.f = left(left(clip.name.f, len)' : 'clip.value.f, rxlv.dispcols)
    end
end
else numclips = 0

viewline.0 = numclips
return


VIEW_CLIP:
arg clipnum

body = 'Name  : 'clip.name.clipnum||nl'Value : 'clip.value.clipnum
gads = '_Edit clip|_Delete clip|_Rename clip|_Cancel'

ans = rtezrequest(body, gads, title)

select
    when ans = 0 then nop
    when ans = 1 then call edit_clip(clipnum)
    when ans = 2 then call delete_clip(clipnum)
    when ans = 3 then call rename_clip(clipnum)
    otherwise exit 10
end
return


EDIT_CLIP:
arg clipnum
body = 'Enter new value for 'clip.name.clipnum

ans = rtgetstring(clip.value.clipnum, body, title, defgads)
if rtresult = 0 | ans = '' then return

if confirm('Use this value?', clip.name.clipnum, ans,,) then do
    call setclip(clip.name.clipnum, addlf(ans))     /* Convert \nl \cr -> nl cr */
    call get_clips()
end
return


RENAME_CLIP:
arg clipnum
body = 'Enter new name for 'clip.name.clipnum

ans = rtgetstring(clip.name.clipnum, body, title, defgads)
if rtresult = 0 | ans = '' then return

do chk = 1 to numclips
    if clip.name.chk = ans then do
        if confirm('Clip already exists! Overwrite it?'||'0a'x||'Name     : '||,
                    ans, clip.value.chk, clip.value.clipnum, 'Old value: ', 'New value: ') then do
            call setclip(clip.name.clipnum, '')
            call setclip(ans, clip.value.clipnum)
            call get_clips()
        end
        return
    end
end

if confirm('Rename clip?', clip.name.clipnum, ans, 'Old name: ', 'New name: ') then do
    call setclip(clip.name.clipnum, '')
    call setclip(ans, clip.value.clipnum)
    call get_clips()
end
return


DELETE_CLIP:
arg clipnum

if confirm('Delete this clip?', clip.name.clipnum, clip.value.clipnum) then do
    call setclip(clip.name.clipnum, '')
    call get_clips()
end
return


CREATE_CLIP:
newname = rtgetstring(, 'Enter the name of the new clip', title, defgads)
if rtresult = 0 | newname = '' then return

chkvalue = getclip(newname)
if chkvalue ~= '' then do
    do clipcount = 1 to numclips
        if clip.name.clipcount = newname then leave
    end
    if confirm('Clip already exists! Change value?', clip.name.clipcount, clip.value.clipcount) then do
        call edit_clip(clipcount)
    end
end
else do
    newvalue = rtgetstring(, 'Enter the value of the new clip', title, defgads)
    if rtresult = 0 | newvalue = '' then return

    if confirm('Create this clip?', newname, newvalue) then do
        call setclip(newname, addlf(newvalue))
        call get_clips()
    end
end
return


CONFIRM: procedure expose title nl defgads
parse arg txt, name, value, pre1, pre2

if pre1 = '' then pre1 = 'Name  : '
if pre2 = '' then pre2 = 'Value : '

body = txt||nl||pre1||name||nl||pre2||value

if rtezrequest(body, defgads, title) then return 1
return 0


RXLV_HELP: procedure
nl = '0a'x
helptxt = ' Use Cursor/Shift Cursor to'nl,
          'move and Enter to select.'nl,
          '---------------------------'nl,
          'd or Delete: Delete clip'nl,
          'e: Edit clip value'nl,
          'r: Rename clip'nl,
          'n: Create a new clip'nl,
          'u: Update the cliplist'nl,
          'q or Escape: Quit ClipEd'

call rtezrequest(helptxt)
return


RXLV_MAIN: procedure expose viewline. rxlv.
parse arg titletxt, inlinechars

/* Reset key */
rxlv.key = ''

/* Which is bigger - win rows or lines in stemvar? */
if rxlv.disprows > viewline.0 then rxlv.actrows = viewline.0
else rxlv.actrows = rxlv.disprows

/* Get current mouse coordinates */
call forbid
screen = next(rxlv.intui, 56)                         /* IntuitionBase->ActiveScreen */
mousex = c2d(import(offset(screen, 18), 2)) - 50      /* Screen->MouseX */
mousey = c2d(import(offset(screen, 16), 2)) - 50      /* Screen->MouseY */
call permit

/* Open the listview */
call open(rxlv.win, 'RAW:'mousex'/'mousey'/'rxlv.width'/'rxlv.height'/'titletxt'/NOSIZE', 'w')
call writech(rxlv.win, rxlv.nocursor||rxlv.nowordwrap)

/* Initialize window */
if viewline.0 > 0 then do
    rxlv.row = 1
    rxlv.var = 1
    rxlv.topvar = 1
    call writech(rxlv.win, rxlv_getlighty(rxlv.row, rxlv.var)||rxlv.nl||rxlv_getpage(rxlv.var + 1))
end

/* Do ze stuff */
do forever
    rxlv.oldrow = rxlv.row
    rxlv.oldvar = rxlv.var

    char = readch(rxlv.win, 1)
    select
        when char = rxlv.csi then do
            char = readch(rxlv.win, 1)
            select
                when viewline.0 < 2 then nop
                when char = rxlv.cursordown then do
                    if rxlv.oldvar ~= viewline.0 then do
                        line = rxlv_getunlighty()
                        rxlv.var = rxlv.var + 1

                        if rxlv.oldrow < rxlv.actrows then rxlv.row = rxlv.row + 1
                        else do
                            line = line||rxlv.nl
                            rxlv.row = rxlv.actrows
                            rxlv.topvar = rxlv.topvar + 1
                        end
                        call writech(rxlv.win, line||rxlv_getlighty())
                    end
                    else call rxlv_top()
                end
                when char = rxlv.cursorup then do
                    if rxlv.oldvar ~= 1 then do
                        line = rxlv_getunlighty()
                        rxlv.var = rxlv.var - 1

                        if rxlv.oldrow ~= 1 then do
                            rxlv.row = rxlv.row - 1
                            call writech(rxlv.win, line||rxlv_getlighty())
                        end
                        else do
                            rxlv.row = 1
                            rxlv.topvar = rxlv.topvar - 1
                            call writech(rxlv.win, line||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
                        end
                    end
                    else call rxlv_bottom()
                end
                when char = rxlv.scursorup then do
                    if rxlv.oldvar ~= 1 then do
                        rxlv.row = 1
                        rxlv.var = rxlv.topvar

                        if rxlv.oldrow = 1 then do
                            if rxlv.oldvar - rxlv.actrows < 1 then rxlv.topvar = 1
                            else rxlv.topvar = rxlv.oldvar - rxlv.actrows
                            rxlv.var = rxlv.topvar
                            call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.topvar + 1))
                        end
                        else call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
                    end
                    else call rxlv_bottom()
                end
                when char = rxlv.scursordown then do
                    if rxlv.oldvar ~= viewline.0 then do
                        rxlv.row = rxlv.actrows

                        if rxlv.oldrow = rxlv.actrows then do
                            if rxlv.oldvar + rxlv.actrows > viewline.0 then rxlv.topvar = viewline.0 - (rxlv.actrows - 1)
                            else rxlv.topvar = rxlv.oldvar + 1
                            rxlv.var = min(viewline.0, rxlv.topvar + (rxlv.actrows - 1))
                            call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
                        end
                        else do
                            rxlv.var = (rxlv.topvar + rxlv.actrows) - 1
                            call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
                        end
                    end
                    else call rxlv_top()
                end
                otherwise nop
            end
        end
        when char = rxlv.esc then do
            rxlv.key = 'ESC'
            return rxlv_close()
        end
        when char = rxlv.cr then do
            rxlv.key = 'RET'
            return rxlv_close()
        end
        when char = rxlv.del then do
            rxlv.key = 'DEL'
            return rxlv_close()
        end
        when pos(char, inlinechars) > 0 then do
            rxlv.key = char
            return rxlv_close()
        end
        when char = rxlv.help then call rxlv_help()
        otherwise nop
    end
end


RXLV_CLOSE: procedure expose rxlv. viewline.
call close(rxlv.win)
if viewline.0 = 0 then return 0
return rxlv.oldvar


RXLV_TOP: procedure expose rxlv. viewline.
rxlv.var = 1
rxlv.row = 1

if rxlv.topvar = 1 then do   /* Just move to top */
    line = rxlv_getunlighty()
    call writech(rxlv.win, line||rxlv_getlighty())
end
else do
    rxlv.topvar = 1
    call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
end
return


RXLV_BOTTOM: procedure expose rxlv. viewline.
rxlv.var = viewline.0

if viewline.0 <= rxlv.actrows then do
    line = rxlv_getunlighty()
    rxlv.row = viewline.0
    call writech(rxlv.win, line||rxlv_getlighty())
end
else do
    rxlv.row = rxlv.actrows
    rxlv.topvar = (viewline.0 - rxlv.actrows) + 1
    call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
end
return


RXLV_GETPAGE: procedure expose viewline. rxlv.
if viewline.0 = 1 then return ''

top = arg(1)
page = ''
do y = 1 to rxlv.actrows - 2                    /* Lines between first and last */
    page = page||viewline.top||rxlv.nl
    top = top + 1
end
page = page||viewline.top                       /* No newline after last line */
return page


RXLV_GETUNLIGHTY: procedure expose rxlv. viewline.
var = rxlv.oldvar
return rxlv.csi||rxlv.oldrow'H'viewline.var


RXLV_GETLIGHTY: procedure expose rxlv. viewline.
var = rxlv.var
return rxlv.csi||rxlv.row'H'rxlv.hilite||viewline.var||rxlv.off


RXLV_INIT: procedure expose rxlv.
/* Hardcoded minimum values */
rxlv.width = max(100, rxlv.width)
rxlv.height = max(50, rxlv.height)

/* ANSI stuff */
rxlv.csi = '9b'x  ; rxlv.esc = '1b'x
rxlv.help = '7e'x ; rxlv.del = '7f'x
rxlv.nl = '0a'x   ; rxlv.cr = '0d'x
rxlv.off = rxlv.csi||'0m'
rxlv.topleft = rxlv.csi'48'x
rxlv.cls = rxlv.csi'H'rxlv.csi'J'
rxlv.hilite = rxlv.csi'43;32m'
rxlv.nowordwrap = rxlv.csi||'3f376c'x
rxlv.nocursor = rxlv.csi||'302070'x
rxlv.cursorup = '41'x  ; rxlv.cursordown = '42'x
rxlv.scursorup = '54'x ; rxlv.scursordown = '53'x
rxlv.win = 'listwin'

/* GUI constants */
guiheight = 7 ; guiwidth = 8

/* Font info */
rxlv.intui = showlist(l, 'intuition.library',, a)
call forbid
screen = next(rxlv.intui, 56)               /* IntuitionBase->ActiveScreen */
font = next(screen, 136)                    /* Screen->RastPort.Font */
fonty = c2d(import(offset(font, 20), 2))    /* Font->YSize */
fontx = c2d(import(offset(font, 24), 2))    /* Font->XSize */
call permit

/* Listview width */
do while (rxlv.width - guiwidth) // fontx ~= 0
    rxlv.width = rxlv.width + 1
end
rxlv.dispcols = ((rxlv.width - guiwidth) % fontx)
rxlv.filler = copies(' ', rxlv.dispcols)

/* Listview height */
const = guiheight + fonty
do while (rxlv.height - const) // fonty ~= 0
    rxlv.height = rxlv.height + 1
end
rxlv.disprows = (rxlv.height - const) % fonty

return


REPLACE: procedure
parse arg src, old, new

olen = length(old)

do forever
    m = pos(old, src)
    if m = 0 then leave

    src = insert(new, delstr(src, m, olen), m - 1)
end
return src


CHECKLF: procedure expose nl cr
str = arg(1)
if pos(nl, str) > 0 then str = replace(str, nl, '\n')
if pos(cr, str) > 0 then str = replace(str, cr, '\r')
return str


ADDLF: procedure expose nl cr
str = arg(1)
if pos('\n', str) > 0 then str = replace(str, '\n', nl)
if pos('\r', str) > 0 then str = replace(str, '\r', cr)
return str